home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SPX30.ZIP / DEMO04.ZIP / DEMO04.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-06-13  |  2.9 KB  |  135 lines
  1. Program Demo4;
  2.  
  3. { SPX library - GeoMorph demo Copyright 1994 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_vsp,spx_key,spx_geo,spx_sfn,spx_fnc;
  6.  
  7. const
  8.   path  = '';
  9.   gmx   = 50;                    { tile map size }
  10.   gmy   = 50;
  11.   gsx   = 16;                    { tile size }
  12.   gsy   = 16;
  13.   smx   = gmx*gsx;               { tile map size in pixels }
  14.   smy   = gmy*gsy;
  15.   speed : integer = 4;
  16.  
  17. type
  18.   PMyMorph = ^TMyMorph;
  19.   TMyMorph = object(TMorph)
  20.                function geomap(x,y:integer):integer;virtual;
  21.                procedure placegeo(x,y,geonum,cx,cy:integer);virtual;
  22.                procedure nogogeo(x,y,cx,cy:integer); virtual;
  23.              end;
  24.  
  25. var
  26.   MyMorph : PMyMorph;
  27.   gpic    : array[0..20] of pointer;
  28.   map     : array[0..gmy-1,0..gmx-1] of byte;
  29.   pal     : RGBlist;
  30.   flip,
  31.   geo_cnt,
  32.   x,y     : integer;
  33.   ch      : char;
  34.  
  35. procedure setup;
  36. begin
  37.   openmode(2);
  38.   MyMorph := new(PMyMorph,init(gmx,gmy,16,16,21,14,0,0));
  39.   setpageactive(2);
  40.   geo_cnt := loadgmp(path+'demo.gmp',gpic,map);
  41.   loadcolors(path+'demo.pal',pal);
  42.   fsetcolors(pal);
  43.   x := 50; y := 50;
  44. end;
  45.  
  46.  
  47. procedure changexy;
  48. begin
  49.   if np[7,2] or np[8,2] or np[9,2]
  50.     then dec(y,speed)
  51.     else
  52.       if np[1,2] or np[2,2] or np[3,2]
  53.         then inc(y,speed);
  54.   if np[7,2] or np[4,2] or np[1,2]
  55.     then dec(x,speed)
  56.     else
  57.       if np[9,2] or np[6,2] or np[3,2]
  58.         then inc(x,speed);
  59.   if KeyPressed
  60.     then 
  61.         begin
  62.           ch := ReadKey;
  63.         if ch in ['1'..'9']
  64.           then speed := vl(ch);
  65.       end;
  66.   ifix(x,0,smx-1); ifix(y,0,smy-1);
  67. end;
  68.  
  69.  
  70. procedure Animate;
  71. begin
  72.   flip := 0;
  73.   repeat
  74.      flip := (flip+1)mod 4;
  75.      changexy;
  76.      MyMorph^.drawmap(x,y);
  77.      putletter(25,20,5,st(x)+','+st(y));
  78.      putletter(24,19,255,st(x)+','+st(y));
  79.      putletter(25,27,5,'Speed = '+st(speed));
  80.      putletter(24,26,255,'Speed = '+st(speed));
  81.      pset(160,100,255);
  82.      pset(161,101,5);
  83.      pcopy(2,1);
  84.   until key[KEY_ESC];
  85. end;
  86.  
  87. (**) { TMyMorph methods }
  88.  
  89. function TMyMorph.geomap(x,y:integer):integer;
  90. begin
  91.   geomap := map[y,x];
  92. end;
  93.  
  94.  
  95. procedure TMyMorph.nogogeo(x,y,cx,cy:integer);
  96. begin
  97.   fput_clip(x,y,gpic[0]^,false);
  98. end;
  99.  
  100.  
  101. procedure TMyMorph.placegeo(x,y,geonum,cx,cy:integer);
  102. begin
  103.   if geonum in [1..geo_cnt]
  104.     then
  105.       if geonum=2
  106.         then fput_clip(x,y,gpic[1+flip]^,false)
  107.         else fput_clip(x,y,gpic[geonum-1]^,false);
  108. end;
  109.  
  110.  
  111. procedure showit;
  112. begin
  113.   clrscr;
  114.   writeln('SPX library - GeoMorph demo');
  115.   writeln('Copyright 1993 Scott D. Ramsay');
  116.   writeln;
  117.   writeln('Keys:');
  118.   writeln(' ESC          - quit demo');
  119.   writeln(' Arrow keys   - scroll');
  120.   writeln(' 0..9         - change speed');
  121.   writeln;
  122.   write('Press SPACE to continue.');
  123.   clearbuffer;
  124.   repeat until key[KEY_SPACE];
  125. end;
  126.  
  127.  
  128. begin
  129.   showit;
  130.   setup;
  131.   Animate;
  132.   dispose(MyMorph,done);
  133.   closemode;
  134. end.
  135.